home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / dialogs.tcl < prev    next >
Encoding:
Text File  |  1999-02-03  |  62.4 KB  |  2,127 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "dialogs.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 3/2/1999 {10:03:32 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Much copyright (c) 1997-1998  Vince Darley, all rights reserved, 
  15.  # rest Pete Keleher, Johan Linde.
  16.  # 
  17.  # Reorganisation carried out by Vince Darley with much help from Tom 
  18.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  19.  # Alpha is shareware; please register with the author using the register 
  20.  # button in the about box.
  21.  #  
  22.  #  Description: 
  23.  # 
  24.  # Much more flexible dialogs for querying the user about flags and
  25.  # vars.  These may be global, mode-dependent, or package-dependent.
  26.  # 
  27.  # Things you may wish to do:
  28.  # 
  29.  #  dialog::pkg_options Pkg
  30.  #  
  31.  # creates a dialog for all array entries 'PkgmodeVars'.  These
  32.  # must have been previously declared using 'newPref'.  These
  33.  # variables are _not_ copied into the global scope; only
  34.  # existing as array entries.
  35.  # 
  36.  # Note that rather than setting up traces on variables, you are
  37.  # often better off using the optional proc argument to newPref;
  38.  # the name of a procedure to call if that element is changed by
  39.  # the user.
  40.  # 
  41.  # The old procedure 'newModeVar' is obsolete.  Use the
  42.  # new procedure 'newPref'.  Why?  It has optional arguments
  43.  # which allow you to declare:
  44.  # 
  45.  #  lists
  46.  #  indexed lists
  47.  #  folders
  48.  #  files
  49.  #  bindings
  50.  #  menu-bindings
  51.  #  applications
  52.  #  variable-list elements
  53.  #  array elements
  54.  #  
  55.  # all of which can be set using the same central mode/global
  56.  # dialogs.
  57.  #  
  58.  # It also lets you add an optional procedure to call when an
  59.  # item changes...  Also if Alpha upgrades to Tcl 8 and namespaces, 
  60.  # it is easy to modify that central procedure to fit everything 
  61.  # with the new scheme.
  62.  # 
  63.  # Most modes will just want to declare their vars using newPref.  
  64.  # There is usually no need to do _anything_ else.
  65.  # 
  66.  # ---
  67.  # 
  68.  # The prefs dialog procs below were based upon Pete Keleher's 
  69.  # originals.
  70.  # ###################################################################
  71.  ##
  72.  
  73. namespace eval dialog {}
  74. namespace eval global {}
  75. namespace eval flag {}
  76.  
  77.  
  78.     
  79. # ◊◊◊◊ Toplevel dialog procedures ◊◊◊◊ #
  80.  
  81. ## 
  82.  # -------------------------------------------------------------------------
  83.  # 
  84.  # "dialog::pkg_options" --
  85.  # 
  86.  #  Make a dialog for the given package, with 'title' for the dialog box.
  87.  #  'not_global' indicates the variables are never copied into the global
  88.  #  scope, remaining in their array ${pkg}modeVars (or '$var' if it is given)
  89.  # 
  90.  # Results:
  91.  #  Nothing
  92.  # 
  93.  # Side effects:
  94.  #  May modify any of the given package's variables.
  95.  # 
  96.  # --Version--Author------------------Changes-------------------------------
  97.  #    1.0     <darley@fas.harvard.edu> original
  98.  # -------------------------------------------------------------------------
  99.  ##
  100. proc dialog::pkg_options {pkg {title ""} {not_global 1} {var ""}} {
  101.     if {!$not_global} {
  102.     # make sure the package variables are global
  103.     global ${pkg}modeVars
  104.     if {[info exists ${pkg}modeVars]} {
  105.         foreach v [array names ${pkg}modeVars] {
  106.         global $v
  107.         set $v [set ${pkg}modeVars($v)]
  108.         }
  109.     }
  110.     }
  111.     if {$title == ""} { 
  112.     set title "Preferences for the '[quote::Prettify $pkg]' package" 
  113.     }
  114.     if {$not_global} {
  115.     global dialog::_not_global_flag
  116.     if {$var == ""} {
  117.         set dialog::_not_global_flag ${pkg}modeVars
  118.     } else {
  119.         set dialog::_not_global_flag $var
  120.     }
  121.     }
  122.     set err [catch {dialog::modifyModeFlags $title $not_global $pkg} result]
  123.     if {$not_global} {
  124.     global dialog::_not_global_flag
  125.     set dialog::_not_global_flag ""
  126.     }
  127.     if {$err} {
  128.     error $result
  129.     }
  130. }
  131. proc dialog::edit_array {var {title ""}} {
  132.     if {$title == ""} {set title "Contents of '$var' array"}
  133.     dialog::pkg_options "" $title 1 $var
  134. }
  135. ## 
  136.  # -------------------------------------------------------------------------
  137.  # 
  138.  # "dialog::variable" --
  139.  # 
  140.  #  Ask for a value, with default given by the given variable, and using
  141.  #  that variable's type (list, file, ...) as a constraint.
  142.  #  
  143.  #  Currently assumes the variable is a list var, but this will change.
  144.  # -------------------------------------------------------------------------
  145.  ##
  146. proc dialog::variable {var {title ""}} {
  147.     if {$title == ""} { set title [quote::Prettify $var] }
  148.     return [dialog::optionMenu $title [flag::options $var] \
  149.       [uplevel [list set $var]]]
  150. }
  151.  
  152.  
  153. ## 
  154.  # -------------------------------------------------------------------------
  155.  # 
  156.  # "dialog::paged" --
  157.  # 
  158.  #  Under development.  Not yet usable!
  159.  # -------------------------------------------------------------------------
  160.  ##
  161. proc dialog::paged {args} {
  162.     getOpts {-pageproc}
  163.     set pages [lindex $args 0]
  164.     lappend dialog -m [concat [lindex $pages 0] $pages] 100 10 200 40
  165.     set xmax -1
  166.     set ymax -1
  167.     set i 1
  168.     foreach page $pages {
  169.     lappend dialog -n $page
  170.     set contents [$opts(-pageproc) $page 20 50]
  171.     set x [lindex $contents 0]
  172.     set y [lindex $contents 1]
  173.     set contents [lindex $contents 2]
  174.     if {$x > $xmax} { set xmax $x }
  175.     if {$y > $ymax} { set ymax $x }
  176.     incr i
  177.     }
  178.     incr ymax 15
  179.     incr xmax 20
  180.     eval dialog -w $xmax -h [expr {$ymax+40}] [dialog::okcancel 10 ymax] $dialog
  181. }
  182.  
  183. proc helperApps {} {
  184.     set sigs [info globals *Sig]
  185.     regsub -all {Sig} $sigs {} sigs
  186.     set sig [listpick -p "Change/inspect which helper?" [lsort $sigs]]
  187.     set sig ${sig}Sig
  188.     global $sig
  189.     if {![info exists $sig]} { set $sig "" }
  190.     set nsig [dialog::askFindApp $sig [set $sig]]
  191.     if {$nsig != "" && [set $sig] != $nsig} {
  192.     set $sig $nsig
  193.     global modifiedVars
  194.     lappend modifiedVars $sig
  195.     }
  196. }
  197.  
  198. proc suffixMappings {} {
  199.     global filepats
  200.     
  201.     set l1 5
  202.     set w1 38
  203.     set l2 [expr {$l1 + $w1 + 5}]
  204.     set w2 200
  205.     set h 18
  206.     set top 5
  207.     set mar 5
  208.     
  209.     set modes [lsort -ignore [array names filepats]]
  210.     set len [expr {[llength $modes] + 1}]
  211.     set modes1 [lrange $modes 0 [expr {$len/2 - 1}]]
  212.     set modes2 [lrange $modes [expr {$len/2}] end]
  213.     
  214.     foreach m $modes1 {
  215.     lappend items -t $m $l1 $top [expr {$l1 + $w1}] [expr {$top + $h}]
  216.     lappend items -e $filepats($m) $l2 $top [expr {$l2 + $w2}] \
  217.       [expr {$top + $h - 2}]
  218.     incr top [expr {$h + $mar}]
  219.     }
  220.     
  221.     set top2 5
  222.     set l1 [expr {$l2 + $w2 + 20}]
  223.     set l2 [expr {$l1 + $w1 + 5}]
  224.     foreach m $modes2 {
  225.     lappend items -t $m $l1 $top2 [expr {$l1 + $w1}] [expr {$top2 + $h}]
  226.     lappend items -e $filepats($m) $l2 $top2 [expr {$l2 + $w2}] \
  227.       [expr {$top2 + $h - 2}]
  228.     incr top2 [expr {$h + $mar}]
  229.     }
  230.     
  231.     if {$top2 > $top} {
  232.     set top $top2
  233.     }
  234.     incr top $mar
  235.     
  236.     set l1 5
  237.     lappend buts -b OK $l1 $top [expr {$l1 + 60}] [expr {$top + 20}]
  238.     lappend buts -b Cancel [expr {$l1 + 100}] $top [expr {$l1 + 160}] \
  239.       [expr {$top + 20}]
  240.     
  241.     set res [eval "dialog -w [expr {$l2 + $w2 + 10}] -h [expr {$top + 27}]" \
  242.       $buts $items]
  243.     
  244.     if {[lindex $res 0]} {
  245.     set res [lrange $res 2 end]
  246.     
  247.     foreach m [lsort -ignore [array names filepats]] {
  248.         if {$filepats($m) != [lindex $res 0]} {
  249.         lappend changed [list $m [lindex $res 0]]
  250.         }
  251.         set res [lrange $res 1 end]
  252.     }
  253.     
  254.     foreach pair $changed {
  255.         eval addArrDef filepats [lrange $pair 0 1]
  256.         set filepats([lindex $pair 0]) [lindex $pair 1]
  257.     }
  258.     }
  259.     mode::updateSuffixes
  260. }
  261. proc dialog::mode {flags vars {title ""}} {
  262.     set lim [expr {10 - [llength $flags]/4}]
  263.     if {[llength $vars] > $lim } {
  264.     set args {}
  265.     set nvars [llength $vars]
  266.     set j 0
  267.     for {set i 0} {$i < $nvars} {incr i $lim ; set lim 10} {
  268.         lappend args [list "Page [incr j] of ${title}" $flags \
  269.           [lrange $vars $i [expr {$i+$lim -1}]]]
  270.         set flags ""
  271.     }
  272.     dialog::multipage $args
  273.     } else {
  274.     dialog::onepage $flags $vars $title
  275.     }
  276. }
  277. ## 
  278.  # -------------------------------------------------------------------------
  279.  # 
  280.  # "dialog::modifyModeFlags" --
  281.  # 
  282.  #  Currently 'not_global == 0' implies this is a mode, or at least that
  283.  #  the variables are stored in ${mm}modeVars(...)
  284.  #  
  285.  #  'not_global == 1' implies that the variables are stored in the
  286.  #  array given by the value of the variable 'dialog::_not_global_flag'
  287.  #  
  288.  #  Recently removed a call to mode::updateSuffixes which is not necessary
  289.  # -------------------------------------------------------------------------
  290.  ##
  291. proc dialog::modifyModeFlags {{title ""} {not_global 0} {mm ""}} {
  292.     global mode invisibleModeVars modifiedArrayElements \
  293.       dialog::_not_global_flag allFlags flag::procs
  294.     # Check whether this is a mode or package, and where variable values
  295.     # are stored, and whether that's at the global level as well as in
  296.     # an array...
  297.     if {$not_global} {
  298.     set storage ${dialog::_not_global_flag}
  299.     if {$title == ""} {
  300.         set title "Preferences for '${mm}' package"
  301.     }
  302.     } else {
  303.     if {$mm == ""} { 
  304.         set mm $mode 
  305.         if {$mm == ""} {
  306.         alertnote "No mode set!"
  307.         return
  308.         }
  309.     }
  310.     set storage ${mm}modeVars
  311.     if {$title == ""} {
  312.         set title "Preferences for '${mm}' mode"
  313.     }
  314.     }
  315.     # check for mode specific proc
  316.     if {[info commands ${mm}modifyFlags] != ""} {${mm}modifyFlags; return}
  317.     if {[info tclversion] >= 8.0} { set storage ::$storage }
  318.     set flags {}
  319.     set vars {}
  320.     global $storage ${storage}Invisible
  321.     if {[info exists $storage]} {
  322.     set unsortedNames [array names $storage]
  323.     set colors {}
  324.     set rest {}
  325.     foreach i $unsortedNames {
  326.         if {[regexp {Colou?r$} $i]} {
  327.         lappend colors $i
  328.         } else {
  329.         lappend rest $i
  330.         }
  331.     }
  332.     
  333.     foreach v [concat [lsort $rest] [lsort $colors]] {
  334.         if {[info exists invisibleModeVars($v)] \
  335.           || [info exists ${storage}Invisible($v)]} continue
  336.         
  337.         if {[lsearch $allFlags $v] >= 0} {
  338.         lappend flags $v
  339.         } else {
  340.         lappend vars $v
  341.         }
  342.     }
  343.     
  344.     set values_items [dialog::mode $flags $vars $title]
  345.     set res [lindex $values_items 0]
  346.     set editItems [lindex $values_items 1]
  347.     unset values_items
  348.     
  349.     foreach fset $editItems {
  350.         if {[llength $fset] > 1} {
  351.         set fset [lrange $fset 1 end]
  352.         }
  353.         foreach flag $fset {
  354.         set val [lindex $res 0]
  355.         set res [lrange $res 1 end]
  356.         dialog::postManipulate
  357.         if {$not_global} {
  358.             # it's a package which keeps its vars in the array
  359.             if {[set ${storage}($flag)] != $val} {
  360.             set ${storage}($flag) $val
  361.             lappend modifiedArrayElements [list $flag $storage]
  362.             if {[info exists flag::procs($flag)]} {
  363.                 eval [set flag::procs($flag)] [list $flag]
  364.             }
  365.             }
  366.         } else {
  367.             # modes keep a copy of their vars at the global 
  368.             # level when active
  369.             global $flag
  370.             if {[set $flag] != $val} {
  371.             set $flag $val
  372.             set ${storage}($flag) $val
  373.             lappend modifiedArrayElements [list $flag $storage]
  374.             
  375.             if {[info exists flag::procs($flag)]} {
  376.                 eval [set flag::procs($flag)] [list $flag]
  377.             }
  378.             }
  379.         }
  380.         }
  381.     }
  382.     } else {
  383.     alertnote "The '$mm' mode/package has no preference settings."
  384.     }
  385.     
  386.     hook::callAll dialog::modifyModeFlags $mm $title
  387.     
  388. }
  389.  
  390. ## 
  391.  # -------------------------------------------------------------------------
  392.  # 
  393.  # "dialog::getAKey" --
  394.  # 
  395.  #  Returns a keystring to be used for binding a key in a menu, 
  396.  #  using a nice dialog box to ask the user.
  397.  # 
  398.  #  Possible improvements: we could replace the dialog
  399.  #  box with a status-line prompt (which would allow the use of
  400.  #  getModifiers to check what keys the user pressed).
  401.  #  
  402.  #  Now handles 'prefixChar' bindings for non-menu items.
  403.  #  i.e. you can use this dialog to bind something to 'ctrl-x ctrl-s',
  404.  #  for instance.
  405.  # 
  406.  #  If the name contains '/' it is considered to be two items,
  407.  #  separated by that '/', which are to take the same binding,
  408.  #  except that one of them will use the option key.
  409.  #  
  410.  #  Similarly '//' means use shift, '///' means shift-option,
  411.  #  For instance 'dialog::getAKey close/closeAll//closeFloat /W<O'
  412.  #  would give you the menu-item for 'close' in the file menu. 
  413.  #  except these last two aren't implemented yet ;-)
  414.  # --Version--Author------------------Changes-------------------------------
  415.  #    1.0     Johan Linde         original
  416.  #    1.1     <darley@fas.harvard.edu> can do non-menu bindings too
  417.  #    1.2     <darley@fas.harvard.edu> handles arrow keys
  418.  #    1.2.1   Johan Linde        handles key pad keys
  419.  # -------------------------------------------------------------------------
  420.  ##
  421. proc dialog::getAKey {{name {}} {keystr {}} {for_menu 1}} {
  422.     global keys::func
  423.     # two lists for any other keys which look better with a text description
  424.     set otherKeys {"<No binding>" "-" Space}
  425.     set otherKeyChars [list "" "" " "]
  426.     if {!$for_menu} {
  427.     lappend otherKeys Left Right Up Down "Key pad =" \
  428.       "Key pad /" "Key pad *" "Key pad -" "Key pad +" "Key pad ."
  429.     lappend otherKeyChars "" "" "\x10" "" Kpad= \
  430.       Kpad/ Kpad* Kpad- Kpad+ Kpad.
  431.     for {set i 0} {$i < 10} {incr i} {
  432.         lappend otherKeys "Key pad $i"
  433.         lappend otherKeyChars Kpad$i
  434.     }
  435.     }
  436.     set nname $name
  437.     set shift-opt [expr {![regsub {///} $nname { so-} $nname]}]
  438.     set shift  [expr {![regsub {//} $nname { s-} $nname]}]
  439.     set option [expr {![regsub {/} $nname { o-} $nname]}]
  440.     if {[string length $keystr]} {
  441.     set values "0 0"
  442.     set mkey [keys::verboseKey $keystr normal]
  443.     if {$normal} {
  444.         lappend values "Normal Key"
  445.     } else {
  446.         lappend values $mkey
  447.         set mkey {}
  448.     }
  449.     lappend values [regexp {<U} $keystr]
  450.     lappend values [regexp {<B} $keystr]
  451.     if {!$for_menu} {
  452.         if {[regexp "«(.*)»" $keystr "" i]} {
  453.         if {$i == "e"} {
  454.             lappend values "escape"
  455.         } else {
  456.             lappend values "ctrl-$i"
  457.         }
  458.         } else {
  459.         lappend values "<none>"
  460.         }
  461.     }
  462.     if {$option} {lappend values [regexp {<I} $keystr]}
  463.     lappend values [regexp {<O} $keystr]
  464.     lappend values $mkey
  465.     } else {
  466.     set values {0 0 "" 0 0}
  467.     if {!$for_menu} { lappend values <none> }
  468.     if {$option} {lappend values 0}
  469.     lappend values 0 ""
  470.     }
  471.     if {$for_menu} {
  472.     set title "Menu key binding"
  473.     } else {
  474.     set title "Key binding"
  475.     set prefixes [keys::findPrefixChars]
  476.     foreach i $prefixes {
  477.         lappend prefix "ctrl-$i"
  478.     }
  479.     lappend prefixes e
  480.     lappend prefix "escape"
  481.     }
  482.     if {$name != ""} { append title " for '$name'" }
  483.     set usep [info exists prefix]
  484.     global alpha::modifier_keys
  485.     while {1} {
  486.     # Build box
  487.     set box "-t [list $title] 10 10 315 25  -t Key 10 40 40 55 \
  488.       -m [list [concat [list [lindex $values 2]] \
  489.       [list "Normal key"] $otherKeys ${keys::func}]] 80 40 180 57 \
  490.       -c Shift [list [lindex $values 3]] 10 70 60 85 \
  491.       -c Control [list [lindex $values 4]] 80 70 150 85"
  492.     if {$usep} {
  493.         lappend box -t Prefix 190 40 230 55  \
  494.           -m [concat [list [lindex $values 5]]  "<none>" "-" $prefix] \
  495.           235 40 315 57
  496.     }
  497.     if {$option} {
  498.         lappend box -c [lindex ${alpha::modifier_keys} 2] \
  499.           [lindex $values [expr {5 + $usep}]] 160 70 220 85
  500.     }
  501.     lappend box -c [lindex ${alpha::modifier_keys} 0] \
  502.       [lindex $values [expr {5 + $option +$usep}]] 230 70 315 85
  503.     lappend box -n "Normal key" -e [lindex $values [expr {6 + $option +$usep}]] 50 40 70 55
  504.     set values [eval [concat dialog -w 330 -h 130 -b OK 20 100 85 120 -b Cancel 105 100 170 120 $box]]
  505.     # Interpret result
  506.     if {[lindex $values 1]} {error "Cancel"}
  507.     # work around a little Tcl problem
  508.     regsub "\{\{\}" $values "\\\{" values
  509.     set elemKey [string toupper [string trim [lindex $values [expr {6 + $option +$usep}]]]]
  510.     set special [lindex $values 2]
  511.     set keyStr ""
  512.     if {[lindex $values 3]} {append keyStr "<U"}
  513.     if {[lindex $values 4]} {append keyStr "<B"}
  514.     if {$option && [lindex $values [expr {5 + $usep}]]} {append keyStr "<I"}
  515.     if {[lindex $values [expr {5 + $option +$usep}]]} {append keyStr "<O"}
  516.     if {$usep} {
  517.         set pref [lindex $values 5]
  518.         if {$pref != "<none>"} {
  519.         set i [lsearch -exact $prefix $pref]
  520.         append keyStr "«[lindex $prefixes $i]»"
  521.         }
  522.     }
  523.     if {[string length $elemKey] > 1 && $special == "Normal key"} {
  524.         alertnote "You should only give one character for key binding."
  525.     } else {
  526.         if {$for_menu} {
  527.         if {$special == "Normal key" && [text::Ascii $elemKey] > 126} {
  528.             alertnote "Sorry, can't define a key binding with $elemKey."
  529.         } elseif {$elemKey != "" && $special == "Normal key" && ($keyStr == "" || $keyStr == "<U")} {
  530.             alertnote "You must choose at least one of the modifiers control, option and command."
  531.         } elseif {![regexp {F[0-9]} $special] && $special != "Tab" && $special != "Normal key" && $special != "<No binding>" && $keyStr == ""} {
  532.             alertnote "You must choose at least one modifier."
  533.         } else {
  534.             break
  535.         }
  536.         } else {
  537.         break
  538.         }
  539.     }
  540.     }
  541.     if {$special == "<No binding>"} {set elemKey ""}
  542.     if {$special != "Normal key" && $special != "<No binding>"} {
  543.     if {[set i [lsearch -exact $otherKeys $special]] != -1} {
  544.         set elemKey [lindex $otherKeyChars $i]
  545.     } else {
  546.         set elemKey [text::Ascii [expr {[lsearch -exact ${keys::func} $special] + 97}] 1]
  547.     }
  548.     }
  549.     if {![string length $elemKey]} {
  550.     set keyStr ""
  551.     } else {
  552.     append keyStr "/$elemKey"
  553.     }    
  554.     return $keyStr
  555. }
  556.  
  557. ## 
  558.  # -------------------------------------------------------------------------
  559.  # 
  560.  # "dialog::optionMenu" --
  561.  # 
  562.  #  names is the list of items.  An item '-' is a divider, and empty items
  563.  #  are not allowed.
  564.  # -------------------------------------------------------------------------
  565.  ##
  566. proc dialog::optionMenu {prompt names {default ""} {index 0}} {
  567.     if {$default == ""} {set default [lindex $names 0]}
  568.     
  569.     set y 5
  570.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  571.     if {[string length $prompt] > 60} { set w 500 }
  572.     
  573.     # in case we need a wide pop-up area that needs more room
  574.     set popUpWidth [expr {7 * [maxListItemLength $names]}]
  575.     set altWidth [expr {$popUpWidth + 60}]
  576.     set w [expr {$altWidth > $w ? $altWidth : $w}]
  577.     
  578.     set dialog [dialog::text $prompt 5 y [expr {int($w/6.7)}]]
  579.     incr y 10
  580.     eval lappend dialog [dialog::menu 30 y $names $default $popUpWidth]
  581.     incr y 20
  582.     eval lappend dialog [dialog::okcancel [expr {$w - 160}] y 0]
  583.     set res [eval dialog -w $w -h $y $dialog]
  584.     
  585.     if {[lindex $res 2]} { error "Cancel" } 
  586.     # cancel was pressed
  587.     if {$index} {
  588.     # we have to take out the entries correponding to pop-up 
  589.     # menu separator lines -trf
  590.     set possibilities [lremove -all $names "-"]
  591.     return [lsearch -exact $possibilities [lindex $res 0]]
  592.     } else {
  593.     return [lindex $res 0]
  594.     }
  595. }
  596.  
  597. ## 
  598.  # -------------------------------------------------------------------------
  599.  # 
  600.  # "dialog::alert" --
  601.  # 
  602.  #  Identical to 'alertnote' but copes with larger blocks of text, and
  603.  #  resizes to that text as appropriate.
  604.  # -------------------------------------------------------------------------
  605.  ##
  606. proc dialog::alert {args} {
  607.     eval [list dialog::yesno -y "Ok" -n ""] $args
  608. }
  609.  
  610. ## 
  611.  # -------------------------------------------------------------------------
  612.  # 
  613.  # "dialog::yesno" --
  614.  # 
  615.  #  Make a dialog with between 1 and 3 buttons, representing '1', '0' and
  616.  #  error "Cancel" respectively.  The names of the first two can be given
  617.  #  with '-y name' and '-n name' respectively.  The cancel button is
  618.  #  only used if a '-c' flag is given (and its name is fixed).
  619.  #  
  620.  #  The procedure automatically sizes the dialog and buttons to fit the
  621.  #  enclosed text.
  622.  # -------------------------------------------------------------------------
  623.  ##
  624. proc dialog::yesno {args} {
  625.     # too long for Alpha's standard dialog
  626.     getOpts {-y -n}
  627.     set prompt [lindex $args 0]
  628.     set y 5
  629.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  630.     if {[string length $prompt] > 60} { set w 500 }
  631.     
  632.     set dialog [dialog::text $prompt 5 y [expr {int($w/6.7)}]]
  633.     incr y 10
  634.     set x 10
  635.     if {[info exists opts(-y)] && $opts(-y) != ""} {
  636.     lappend buttons $opts(-y) "" y
  637.     } else {
  638.     lappend buttons "Yes" "" y
  639.     }
  640.     if {[info exists opts(-n)]} {
  641.     if {$opts(-n) != ""} {
  642.         lappend buttons $opts(-n) "" y
  643.     }
  644.     } else {
  645.     lappend buttons "No" "" y
  646.     }
  647.     if {[info exists opts(-c)]} {
  648.     lappend buttons "Cancel" "" y
  649.     }
  650.     eval lappend dialog [eval dialog::button $buttons]
  651.     if {$x > $w} { set w [expr {$x + 15}] }
  652.     set res [eval dialog -w $w -h $y $dialog]
  653.     if {[lindex $res 0]} {
  654.     return 1
  655.     } elseif {[lindex $res 1]} {
  656.     return 0
  657.     } else {
  658.     error "cancelled"
  659.     }
  660. }
  661.  
  662. proc dialog::password {{msg "Please enter password:"}} {
  663.     set values [dialog -w 300 -h 90 -t $msg 10 20 290 35 \
  664.       -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  665.     if {[lindex $values 2]} {error "Cancel"}
  666.     return [lindex $values 0]
  667. }
  668.  
  669. proc global::allPrefs {{which "AllPreferences"}} {
  670.     dialog::resetModified
  671.     global flagPrefs varPrefs
  672.     global::updateHelperFlags
  673.     global::updateMiscFlags
  674.     set AllPreferences [array names flagPrefs]
  675.     set InterfacePreferences {Tiling Window Wrapping Gui}
  676.     set StandardPreferences {Backups Electrics Miscellaneous Printer Tags WWW}
  677.     set OtherPreferences [lremove -l $AllPreferences \
  678.       $InterfacePreferences $StandardPreferences]
  679.     foreach nm [set [join ${which} ""]] {
  680.     lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  681.     }
  682.     dialog::is_global {
  683.     dialog::global_adjust_flags [dialog::multipage $args]
  684.     }
  685. }
  686.  
  687. proc dialog::preferences {menu nm} {
  688.     global flagPrefs varPrefs
  689.     if {[string match "Suffix Mappings" $nm]} {
  690.     return [suffixMappings]
  691.     } elseif {[string match "Menus And Features" $nm]} {
  692.     return [global::menusAndFeatures]
  693.     } elseif {[string match "Edit Prefs File" $nm]} {
  694.     return [global::editPrefsFile]
  695.     }
  696.     if {![info exists flagPrefs($nm)]} { 
  697.     set nm "[string toupper [string index $nm 0]][string range $nm 1 end]" 
  698.     }
  699.     if {[string match "*Preferences" $nm]} { return [global::allPrefs $nm] }
  700.     if {$nm == "Miscellaneous"} { global::updateMiscFlags }
  701.     if {$nm == "Helpers"} { global::updateHelperFlags }
  702.     dialog::is_global {
  703.     dialog::global_adjust_flags [dialog::onepage $flagPrefs($nm) $varPrefs($nm) "$nm preferences…"]
  704.     }
  705. }
  706.  
  707. # ◊◊◊◊ Finding applications ◊◊◊◊ #
  708.  
  709.  
  710. proc dialog::askFindApp {var sig} {
  711.     if {$sig == ""} {
  712.     set text "Currently unassigned.   Set?"
  713.     } elseif {[catch {nameFromAppl '$sig'} name]} {
  714.     set text "App w/ sig '$sig' doesn't seem to exist.   Change?"
  715.     } else {
  716.     set text "Current value is '$name'.   Change?"
  717.     }
  718.     if {[dialog::yesno $text]} {
  719.     set nsig [dialog::findApp $var $sig]
  720.     set app [nameFromAppl $nsig]
  721.     if {[dialog::yesno "Are you sure you want to set $var to '$nsig' (mapped to '$app')?"]} {
  722.         return $nsig
  723.     }
  724.     }
  725.     return ""
  726. }
  727.  
  728. proc dialog::findApp {var sig} {
  729.     global ${var}s modifiedVars
  730.     if {[info exists ${var}s]} {
  731.     # have a list of items
  732.     set sigs [set ${var}s]
  733.     
  734.     set s 0
  735.     foreach f $sigs {
  736.         if {![catch {nameFromAppl $f} path]} {
  737.         lappend items [file tail $path]
  738.         lappend itemsigs $f
  739.         incr s
  740.         }
  741.     }
  742.     if {$s} {
  743.         lappend items "-" "Locate manually…"
  744.         if {[catch {dialog::optionMenu "Select a new helper for '$var':" \
  745.           $items "" 1} p]} {
  746.         return ""
  747.         }
  748.         # we removed a bunch of items above, so have to look here
  749.         if {$p < $s} {
  750.         return [lindex $itemsigs $p]
  751.         }
  752.     }
  753.     if {!$s || $p >= $s} {
  754.         set nsig [dialog::_findApp $var $sig]
  755.         if {$nsig != ""} {
  756.         if {[lsearch $sigs $nsig] == -1} {
  757.             lappend ${var}s $nsig
  758.             lappend modifiedVars ${var}s
  759.         }
  760.         }
  761.     } else {
  762.         set nsig [lindex $sigs $p]
  763.     }
  764.     return $nsig
  765.     } else {
  766.     return [dialog::_findApp $var $sig]
  767.     }
  768. }
  769.  
  770. proc dialog::_findApp {var sig} {
  771.     if {[catch {getfile "Locate new helper for '$var':"} path]} { return "" }
  772.     set nsig [getFileSig $path]
  773.     set app [nameFromAppl $nsig]
  774.     if {$app != $path} {
  775.     alertnote "Appl sig '$nsig' is mapped to '$app', not '$path'. Remove the former, or rebuild your desktop."
  776.     return ""
  777.     }
  778.     return $nsig
  779. }
  780.  
  781. # ◊◊◊◊ Global/mode menus ◊◊◊◊ #
  782.  
  783. ## 
  784.  # -------------------------------------------------------------------------
  785.  # 
  786.  # "dialog::pickMenusAndFeatures" --
  787.  # 
  788.  #  Prompt the user to select menus and features either globally or
  789.  #  for a given mode.  We need to make sure that those items in
  790.  #  the mode-list which are also in the global list aren't forgotten
  791.  #  (since they are removed from the dialog).
  792.  # -------------------------------------------------------------------------
  793.  ##
  794. proc dialog::pickMenusAndFeatures {mode} {
  795.     global mode::features global::features 
  796.     set all [package::partition $mode]
  797.     set menus1 [lindex $all 0]
  798.     set menus2 [lindex $all 1]
  799.     set menus3 [lindex $all 2]
  800.     set features1 [lindex $all 3]
  801.     set features2 [lindex $all 4]
  802.     set features3 [lindex $all 5]
  803.     set all [eval concat $all]
  804.     # decide on two or three column
  805.     #set endw [expr [llength $all] > 50 ? 560 : 380]
  806.     set endw 560
  807.     set chosen ""
  808.     set notchosen ""
  809.     if {$mode == "global"} {
  810.     set current ${global::features}
  811.     set prefix "Select global #"
  812.     lappend names0 {Select global menus}
  813.     set types [list Usual "" "Other possible"]
  814.     } else {
  815.     foreach pkg [set current [set mode::features($mode)]] {
  816.         if {[lsearch -exact ${global::features} $pkg] != -1} {
  817.         lappend chosen $pkg
  818.         } else {
  819.         if {[string index $pkg 0] == "-"} {
  820.             set pkg [string range $pkg 1 end]
  821.             if {[lsearch -exact ${global::features} $pkg] != -1} {
  822.             # these are the ones which are disabled
  823.             lappend notchosen $pkg
  824.             }
  825.         }
  826.         }
  827.     }
  828.     set prefix "Select # for mode '$mode'"
  829.     lappend names0 "Select menus for mode '$mode'" 
  830.     set types [list Usual General "Other possible"]
  831.     }
  832.     set tmpcurrent $current
  833.     while 1 {
  834.     set maxh 0
  835.     set box ""
  836.     set names $names0
  837.     foreach type {menus features off} {
  838.         if {$mode == "global" && $type == "off"} {break}
  839.         set w 20
  840.         set h 45
  841.         set i 0
  842.         if {$type == "off"} {
  843.         set subm "Turn items off"
  844.         set types [list "Usually on for this mode" "Uncheck to disable"]
  845.         set off1 [lsort $chosen]
  846.         set off2 [lsort [lremove -l ${global::features} $chosen]]
  847.         set alloff [concat $off1 $off2]
  848.         } else {
  849.         regsub "\#" $prefix $type subm
  850.         }
  851.         set page 1
  852.         lappend names $subm
  853.         lappend box "-n" $subm
  854.         if {$type == "off"} {
  855.         lappend box -t "These items are currently globally on. You can turn them off just for this mode here."  10 $h [expr {$endw -20}] [expr {$h +15}]
  856.         incr h 20
  857.         }
  858.         foreach block $types {
  859.         incr i
  860.         if {[llength [set ${type}$i]] == 0} {
  861.             continue
  862.         }
  863.         if {$type == "off"} {
  864.             lappend box -t "$block:"
  865.         } else {
  866.             lappend box -t "$block $type:" 
  867.         }
  868.         lappend box 10 $h [expr {$w +160}] [expr {$h +15}]
  869.         incr h 20
  870.         foreach m [set ${type}$i] {
  871.             if {$h > 360} {
  872.             if {$h > $maxh} {set maxh $h}
  873.             incr page
  874.             lappend names "$subm page $page"
  875.             lappend box "-n" "$subm page $page"
  876.             set h 45
  877.             lappend box -t "$block $type continued..." 10 $h \
  878.               [expr {$w +260}] [expr {$h +15}]
  879.             incr h 20
  880.             }
  881.             set name [quote::Prettify $m]
  882.             if {$type == "off"} {
  883.             set tick [expr {([lsearch -exact $notchosen $m] < 0)}]
  884.             } else {
  885.             set tick [expr {([lsearch -exact $tmpcurrent $m] >= 0)}]
  886.             }
  887.             lappend box -c $name $tick $w $h  [expr {$w + 160}] [expr {$h + 15}]
  888.             incr w 180
  889.             if {$w == $endw} {set w 20; incr h 20}
  890.         }
  891.         if {$w != 20} {
  892.             incr h 30 ; set w 20
  893.         }
  894.         }
  895.         if {$h > $maxh} {set maxh $h}
  896.         
  897.     }
  898.     set h $maxh
  899.     incr h 20
  900.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  901.       -b OK 20 $h 85 [expr {$h + 20}] \
  902.       -b Cancel 105 $h 170 [expr {$h + 20}]  \
  903.       -b Help [expr {$endw -200}] $h [expr {$endw - 140}] [expr {$h + 20}] \
  904.       -b Descriptions [expr {$endw -120}] $h [expr {$endw -20}] [expr {$h + 20}] \
  905.       -m [list $names] [expr {($endw - 220)/2}] 10 $endw 30 $box]]
  906.     
  907.     set names0 [list [lindex $values 4]]
  908.     if {[lindex $values 0]} {break}
  909.     if {[lindex $values 1]} {return $current}
  910.     if {[lindex $values 2]} {
  911.         dialog::describeMenusAndFeatures Help
  912.     }
  913.     if {[lindex $values 3]} {
  914.         dialog::describeMenusAndFeatures Describe
  915.     }    
  916.     set tmpcurrent ""
  917.     for {set i 0} {$i < [llength $all]} {incr i} {
  918.         if {[lindex $values [expr {$i + 5}]]} {
  919.         lappend tmpcurrent [lindex $all $i]
  920.         }
  921.     }
  922.     }
  923.  
  924.     for {set i 0} {$i < [llength $all]} {incr i} {
  925.     if {[lindex $values [expr {$i + 5}]]} {lappend chosen [lindex $all $i]}
  926.     }
  927.     if {$mode != "global"} {
  928.     for {set j 0} {$j < [llength [set global::features]]} {incr i ; incr j} {
  929.         if {![lindex $values [expr {$i + 5}]]} {
  930.         # turned one off
  931.         set itm [lindex $alloff $j]
  932.         if {[set idx [lsearch -exact $chosen $itm]] != -1} {
  933.             set chosen [lreplace $chosen $idx $idx "-$itm"]
  934.         } else {
  935.             lappend chosen "-$itm"
  936.         }
  937.         } 
  938.     }
  939.     }
  940.     return $chosen
  941. }
  942.  
  943. proc dialog::describeMenusAndFeatures {{what "Help"}} {
  944.     set all [package::partition]
  945.     set okmenu [lindex $all 0]
  946.     set okfeature [lindex $all 1]
  947.     set okmode [lindex $all 2]
  948.     set all [eval concat $all]
  949.     # decide on two or three column
  950.     set endw [expr {[llength $all] > 50 ? 560 : 380}]
  951.     if {$what == "Help"} {
  952.     set prefix "Read help for a #"
  953.     } else {
  954.     set prefix "Describe a #"
  955.     }
  956.     foreach m {menu feature mode} {
  957.     regsub "\#" $prefix $m subm
  958.     lappend names $subm
  959.     }
  960.     lappend box -m [concat [list [lindex $names 0]] $names] \
  961.       [expr {($endw - 150)/2}] 10 $endw 30
  962.     set maxh 0
  963.     set wincr 160
  964.     foreach type {menu feature mode} {
  965.     set w 20
  966.     set h 45
  967.     regsub "\#" $prefix $type subm
  968.     lappend box "-n" $subm
  969.     if {$type == "mode"} {set wincr 70}
  970.     foreach m [set ok$type] {
  971.         set name [quote::Prettify $m]
  972.         lappend box -b $name $w $h [expr {$w + $wincr}] [expr {$h + 15}]
  973.         incr w [expr {$wincr +20}]
  974.         if {$w == $endw} {set w 20; incr h 20}
  975.     }
  976.     if {$w > 20} {set w 20; incr h 20}
  977.     if {$h > $maxh} {set maxh $h}
  978.     }
  979.     set h $maxh
  980.     incr h 20
  981.     while 1 {
  982.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  983.       -b OK 20 $h 85 [expr {$h + 20}] $box]]
  984.     if {[lindex $values 0]} {return}
  985.     # we hit a button
  986.     for {set i 0} {$i < [llength $all]} {incr i} {
  987.         if {[lindex $values [expr {$i + 2}]]} {
  988.         if {$what == "Help"} {
  989.             package::helpFile [lindex $all $i]
  990.         } else {
  991.             package::describe [lindex $all $i]
  992.         }
  993.         break
  994.         }
  995.     }
  996.     }
  997. }
  998.  
  999.  
  1000. # ◊◊◊◊ Dialog sub-panes ◊◊◊◊ #
  1001.  
  1002. set dialog::_not_global_flag ""
  1003.  
  1004. ## 
  1005.  # -------------------------------------------------------------------------
  1006.  # 
  1007.  # "dialog::flag" --
  1008.  # 
  1009.  #  Builds a dialog-box page to be used for setting global/mode/package
  1010.  #  preferences.  It can contain preferences for flags (on/off), variables,
  1011.  #  list items, mode items, files, folders, apps,...
  1012.  # 
  1013.  # Results:
  1014.  #  part of a script to generate the dialog
  1015.  # 
  1016.  # Side effects:
  1017.  #  sets maxT to the maximum height desired by the dialog
  1018.  # 
  1019.  # --Version--Author------------------Changes-------------------------------
  1020.  #    1.0     Pete Keleher             original
  1021.  #    2.0     <darley@fas.harvard.edu> much more sophisticated (and complex!)
  1022.  # -------------------------------------------------------------------------
  1023.  ##
  1024. proc dialog::flag {flags vars {left 20} {top 40} {title {}}} {
  1025.     global maxT spelling alpha::prefNames dialog::_not_global_flag mode
  1026.     if {[info tclversion] >= 8.0} {
  1027.     cache::read index::prefshelp
  1028.     upvar help help
  1029.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1030.         append vprefix ","
  1031.     }
  1032.     }
  1033.     
  1034.     if {$title != ""} {
  1035.     lappend args "-t" $title 30 10 400 25
  1036.     incr top 25
  1037.     }
  1038.     # if variable names are very long, switch to 2 columns
  1039.     if {[maxListItemLength $flags] > 18} {
  1040.     set perRow 2
  1041.     set width 225
  1042.     } else {
  1043.     set perRow 3
  1044.     set width 150
  1045.     }
  1046.     set height    15
  1047.     
  1048.     set ind 0
  1049.     set l $left
  1050.     foreach f $flags {
  1051.     set fname [quote::Prettify $f]
  1052.     if {$spelling} {text::british fname}
  1053.     lappend args "-c" $fname [dialog::getFlag $f] \
  1054.       $l $top [incr l $width] [expr {$top + $height}]
  1055.     if {[incr ind] % $perRow == 0} { set l $left ; incr top $height }
  1056.     if {[info tclversion] >= 8.0} {
  1057.         if {[info exists prefshelp($vprefix$f)]} {
  1058.         lappend help $prefshelp($vprefix$f)
  1059.         } elseif {[info exists prefshelp($mode,$f)]} {
  1060.         lappend help $prefshelp($mode,$f)
  1061.         } else {
  1062.         lappend help ""
  1063.         }
  1064.     }
  1065.     }
  1066.     
  1067.     if {$ind} {
  1068.     set top [expr {$top + 20}]
  1069.     lappend args -p 100 [expr {$top + 27}] 300 [expr {$top + 28}]
  1070.     } 
  1071.     
  1072.     dialog::buildSection $vars top 440 $left args alpha::prefNames
  1073.     incr top 30
  1074.     
  1075.     if {$top > $maxT} {set maxT $top}
  1076.     return $args
  1077. }
  1078.  
  1079. ## 
  1080.  # -------------------------------------------------------------------------
  1081.  # 
  1082.  # "dialog::buildSection" --
  1083.  # 
  1084.  #  Build a dialog box section for a bunch of preferences.  If 'flag_check'
  1085.  #  is set the prefs can be flags or vars, else just vars.
  1086.  #  
  1087.  #  'yvar' is a variable which contains the current y-pos in the box,
  1088.  #  and should be incremented as appropriate by this procedure.
  1089.  #  'width' is the width of the dialog box (default 420)
  1090.  #  'l' is the left indent of all the items (default 20)
  1091.  #  'dialogvar' is the variable onto which all the construction code
  1092.  #  should be lappended.  If it is not given, then this proc will
  1093.  #  return the items.
  1094.  #  'names', if given, is an array containing textual replacements for
  1095.  #  the names of the variables to be used in the box.
  1096.  #  
  1097.  #  A minimal call would be:
  1098.  #  
  1099.  #  set y 20
  1100.  #  set build [dialog::buildSection [list fillColumn] y]
  1101.  #  eval lappend build [dialog::okcancel 20 y]
  1102.  #  set res [eval dialog -w 480 -h $y $build]
  1103.  #  
  1104.  # -------------------------------------------------------------------------
  1105.  ##
  1106. proc dialog::buildSection {vars yvar {width 420} {l 20} {dialogvar ""} {names ""} {flag_check 1}} {
  1107.     global flag::list flag::type allFlags spelling alpha::colors mode::features \
  1108.       includeDescriptionsInDialogs dialog::_not_global_flag mode
  1109.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  1110.     cache::read index::prefshelp
  1111.     if {[info tclversion] >= 8.0} {
  1112.         upvar help help
  1113.     }
  1114.     }
  1115.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1116.     append vprefix ","
  1117.     }
  1118.     upvar $yvar t
  1119.     if {$dialogvar != ""} {upvar $dialogvar args}
  1120.     if {$names != ""} { upvar $names name }
  1121.     set height 17
  1122.     set lf 135
  1123.     set r [expr {$l + $width}]
  1124.     set rb [expr {$r -45}]
  1125.     foreach vset $vars {
  1126.     if {[llength $vset] > 1} {
  1127.         incr t 5
  1128.         if {[lindex $vset 0] != ""} {
  1129.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1130.         incr t 20
  1131.         }
  1132.         set vset [lrange $vset 1 end]
  1133.     }
  1134.     foreach v $vset {
  1135.         if {$includeDescriptionsInDialogs} {
  1136.         if {[info exists prefshelp($vprefix$v)]} {
  1137.             eval lappend args [dialog::text $prefshelp($vprefix$v) $l t]
  1138.         }
  1139.         }
  1140.         if {[info tclversion] >= 8.0} {
  1141.         if {[info exists prefshelp($vprefix$v)]} {
  1142.             lappend help $prefshelp($vprefix$v)
  1143.         } elseif {[info exists prefshelp($mode,$v)]} {
  1144.             lappend help $prefshelp($mode,$v)
  1145.         } else {
  1146.             lappend help ""
  1147.         }
  1148.         }
  1149.         
  1150.         set vv [dialog::getFlag $v]
  1151.         if {[info exists name($v)]} {
  1152.         set vname $name($v)
  1153.         } else {
  1154.         set vname [quote::Prettify $v]
  1155.         }
  1156.         if {$spelling} {
  1157.         text::british vname
  1158.         }
  1159.         if {$flag_check && [lcontains allFlags $v]} {
  1160.         lappend args "-c" $vname $vv $l $t $r [expr {$t + 15}]
  1161.         incr t 15
  1162.         continue
  1163.         }
  1164.         # attempt to indent correctly
  1165.         set len [string length $vname] 
  1166.         if {$len > 40} {
  1167.         lappend args "-t" "$vname:" $l $t [expr {$r -30}] [expr {$t + $height}]
  1168.         incr t 15
  1169.         set indent 100
  1170.         set tle ""
  1171.         } elseif {$len > 17} {
  1172.         set indent [expr {31 + 7 * $len}]
  1173.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1174.         } else {
  1175.         set indent $lf
  1176.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1177.         }
  1178.         
  1179.         if {[info exists flag::list($v)]} {
  1180.         incr t 5
  1181.         eval lappend args $tle
  1182.         set litems [flag::options $v]
  1183.         if {[regexp "index" [lindex [set flag::list($v)] 0]]} {
  1184.             # set item to index, making sure bad values don't error
  1185.             if {[catch {lindex $litems $vv} vv]} { set vv [lindex $litems 0] }
  1186.         }
  1187.         lappend args "-m" [concat [list $vv] $litems] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1188.         incr t 17
  1189.         } elseif {[regexp "Colou?r$" $v]} {
  1190.         incr t 5
  1191.         eval lappend args $tle
  1192.         lappend args "-m" [concat [list $vv] ${alpha::colors}] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1193.         incr t 17
  1194.         } elseif {[regexp "Mode$" $v]} {
  1195.         incr t 5
  1196.         eval lappend args $tle
  1197.         if {$vv == ""} { set vv "<none>" }
  1198.         lappend args "-m" [concat [list $vv] [concat "<none>" [lsort [array names mode::features]]]] [expr {$l + $indent -2}] $t [expr {$r - 14}] [expr {$t + $height +1}]
  1199.         incr t 17
  1200.         } elseif {[regexp "Sig$" $v]} {
  1201.         eval lappend args $tle
  1202.         set vv [dialog::specialView_Sig $vv]
  1203.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1204.         eval lappend args [dialog::buttonSet $rb $t]
  1205.         incr t 17
  1206.         } elseif {[regexp "SearchPath$" $v]} {
  1207.         eval lappend args $tle
  1208.         if {$vv == ""} {
  1209.             lappend args "-t" "No search paths currently set." \
  1210.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1211.             eval lappend args [dialog::buttonSet $rb $t]
  1212.             incr t 17
  1213.         } else {
  1214.             eval lappend args [dialog::buttonSet $rb $t]
  1215.             foreach ppath $vv {
  1216.             lappend args "-t" [dialog::specialView_file $ppath] \
  1217.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1218.             incr t 17
  1219.             }
  1220.         }
  1221.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1222.         eval lappend args $tle
  1223.         set vv [dialog::specialView_file $vv]
  1224.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1225.         eval lappend args [dialog::buttonSet $rb $t]
  1226.         incr t 17
  1227.         } elseif {[info exists flag::type($v)]} {
  1228.         if {[set flag::type($v)] == "funnyChars"} {
  1229.             set vv [quote::Display $vv]
  1230.             set eh [expr {1 + [string length $vv] / 60}]
  1231.             incr t [expr {7 * $eh}]
  1232.             eval lappend args $tle
  1233.             incr t [expr {5 -7 * $eh}]
  1234.             lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1235.             incr t [expr {5 + 17 * $eh}]
  1236.         } else {
  1237.             eval lappend args $tle
  1238.             set vv [dialog::specialView_[set flag::type($v)] $vv]
  1239.             lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1240.             eval lappend args [dialog::buttonSet $rb $t]            
  1241.             incr t 17
  1242.         }
  1243.         } else {
  1244.         set eh [expr {1 + [string length $vv] / 60}]
  1245.         incr t [expr {7 * $eh}]
  1246.         eval lappend args $tle
  1247.         incr t [expr {5 -7 * $eh}]
  1248.         lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1249.         incr t [expr {5 + 17 * $eh}]
  1250.         }
  1251.     }
  1252.     }
  1253.     if {$dialogvar == ""} {return $args}
  1254. }
  1255. proc dialog::multipage {data} {
  1256.     dialog::resetModified
  1257.     global maxT
  1258.     # in case internal 'command-buttons' are used in the dialog
  1259.     while 1 {
  1260.     
  1261.     set left 20   
  1262.     
  1263.     set names {}
  1264.     set editItems {}
  1265.     set cmd ""
  1266.     set maxT 0
  1267.     foreach arg [lsort $data] {
  1268.         if {[llength $arg] != 3} {error "Bad structure"}
  1269.         lappend names [lindex $arg 0]
  1270.         set flags [lindex $arg 1]
  1271.         set vars [lindex $arg 2]
  1272.         lappend editItems [eval list $flags $vars]
  1273.         eval lappend cmd "-n" [list [lindex $arg 0]] [dialog::flag $flags $vars]
  1274.     }
  1275.     
  1276.     set buttons [dialog::okcancel $left maxT]
  1277.     set height $maxT
  1278.     if {![info exists chosenName]} {set chosenName [lindex $names 0]}
  1279.     if {[info exists help]} {
  1280.         set res [eval [concat dialog -w 480 -h $height \
  1281.           -t "Preferences:" 60 10 140 30 $buttons \
  1282.           -b "Help" 410 10 460 28 \
  1283.           [list -m [concat [list $chosenName] $names] 150 10 405 30] \
  1284.           $cmd -help] [list [concat [list \
  1285.           "Click here to save the current settings." \
  1286.           "Click here to discard any changes you've made to the settings." \
  1287.           "Click here to display textual help on each item in this dialog." \
  1288.           "Use this popup menu, or the cursor keys to select a \
  1289.           different page of preferences."] $help]]]
  1290.     } else {
  1291.         set res [eval [concat dialog -w 480 -h $height \
  1292.           -t "Preferences:" 60 10 140 30 $buttons \
  1293.           -b "Help" 410 10 460 28 \
  1294.           [list -m [concat [list $chosenName] $names] 150 10 405 30] \
  1295.           $cmd]]
  1296.     }
  1297.     
  1298.     set chosenName [lindex $res 3]
  1299.     if {[lindex $res 0]} {
  1300.         return [list [lrange $res 4 end] [eval concat $editItems]]
  1301.     } else {
  1302.         if {[lindex $res 1]} {
  1303.         error "Cancel chosen"
  1304.         }
  1305.         dialog::rememberChanges [list [lrange $res 4 end] [eval concat $editItems]]
  1306.         # Either help, or some set or describe type button was pressed
  1307.         # We need to ensure we remember anything the user has already
  1308.         # changed.
  1309.         if {[lindex $res 2]} {
  1310.         # help pressed
  1311.         set i [lsearch -exact $names [lindex $res 3]]
  1312.         dialog::describe [lindex $editItems $i] "Description of [lindex $res 3] prefs"
  1313.         } else {
  1314.         # a 'set…' button was pressed
  1315.         dialog::handleSet [lrange $res 4 end] [eval concat $editItems]
  1316.         }
  1317.     }
  1318.     # end of large while loop
  1319.     }
  1320.  
  1321. }
  1322.  
  1323. proc dialog::rememberChanges {values_items} {
  1324.     set res [lindex $values_items 0]
  1325.     set editItems [lindex $values_items 1]
  1326.     unset values_items
  1327.     foreach fset $editItems {
  1328.     if {[llength $fset] > 1} {
  1329.         set fset [lrange $fset 1 end]
  1330.     }
  1331.     foreach flag $fset {
  1332.         set val [lindex $res 0]
  1333.         set res [lrange $res 1 end]
  1334.         dialog::postManipulate
  1335.         dialog::modified $flag $val
  1336.     }
  1337.     }
  1338. }
  1339.  
  1340. proc dialog::onepage {flags vars {title ""}} {
  1341.     dialog::resetModified
  1342.     global maxT
  1343.     while 1 {
  1344.     set left 20
  1345.     set maxT 0
  1346.     set args [dialog::flag $flags $vars 20 10 $title]
  1347.     set height [expr {$maxT + 30}]
  1348.     set buttons [dialog::okcancel $left maxT]
  1349.     set height $maxT
  1350.     if {[info exists help]} {
  1351.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1352.           -b "Help" 410 10 460 28 $args -help] \
  1353.           [list [concat [list \
  1354.           "Click here to save the current settings." \
  1355.           "Click here to discard any changes you've made to the settings." \
  1356.           "Click here to display textual help on each item in this dialog." \
  1357.           ] $help]]]
  1358.     } else {
  1359.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1360.           -b "Help" 410 10 460 28 $args]]]
  1361.     }
  1362.     
  1363.     if {[lindex $res 0]} {
  1364.         return [list [lrange $res 3 end] [concat $flags $vars]]
  1365.     } else {
  1366.         
  1367.         if {[lindex $res 1]} {
  1368.         error "Cancel chosen"
  1369.         } 
  1370.         dialog::rememberChanges [list [lrange $res 3 end] [concat $flags $vars]]
  1371.         if {[lindex $res 2]} {
  1372.         # help
  1373.         dialog::describe [concat $flags $vars] $title
  1374.         } else {
  1375.         dialog::handleSet [lrange $res 3 end] [concat $flags $vars]
  1376.         }
  1377.     }
  1378.     # big while loop end
  1379.     }
  1380.     
  1381. }
  1382.  
  1383. proc dialog::describe {vars {title ""}} {
  1384.     if {$title == ""} {
  1385.     set title "Preferences description"
  1386.     }
  1387.     global flag::list flag::type spelling alpha::colors \
  1388.       dialog::_not_global_flag mode
  1389.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1390.     append vprefix ","
  1391.     }
  1392.     cache::read index::prefshelp
  1393.     set height 17
  1394.     set lf 135
  1395.     set l 20
  1396.     set width 420
  1397.     set r [expr {$l + $width}]
  1398.     set rb [expr {$r -45}]
  1399.     set args {}
  1400.     set t 35
  1401.     set height 0
  1402.     set page 1
  1403.     set pages {}
  1404.     foreach vset $vars {
  1405.     if {[llength $vset] > 1} {
  1406.         incr t 5
  1407.         if {[lindex $vset 0] != ""} {
  1408.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1409.         incr t 20
  1410.         }
  1411.         set vset [lrange $vset 1 end]
  1412.     } else {
  1413.         #do this so that vars that have whitespace padding (used to force dialog position)
  1414.         # are not strip of that space in the next "foreach" statement
  1415.         set vset [list [set vset]]
  1416.     }
  1417.     foreach v $vset {
  1418.         set vv [dialog::getFlag $v]
  1419.         if {[info exists name($v)]} {
  1420.         set vname $name($v)
  1421.         } else {
  1422.         set vname [quote::Prettify $v]
  1423.         }
  1424.         if {$spelling} {
  1425.         text::british vname
  1426.         }
  1427.         if {[info exists prefshelp($vprefix$v)]} {
  1428.         append vname ": " [dialog::helpdescription $prefshelp($vprefix$v)]
  1429.         } elseif {[info exists prefshelp($mode,$v)]} {
  1430.         append vname ": " [dialog::helpdescription $prefshelp($mode,$v)]
  1431.         } else {
  1432.         append vname ": no description"
  1433.         }
  1434.         eval lappend args [dialog::text $vname $l t 60]
  1435.         if {$t > 360} {
  1436.         # make another page
  1437.         eval lappend pages -n [list "Page $page"] $args
  1438.         set args {}
  1439.         incr page
  1440.         if {$t > $height} {set height $t}
  1441.         set t 35
  1442.         }
  1443.         
  1444.     }
  1445.     
  1446.     }
  1447.     if {$page > 1} {
  1448.     set t $height
  1449.     set height [expr {$t + 40}]
  1450.     for {set i 1} {$i <= $page} {incr i} {
  1451.         lappend names "Page $i"
  1452.     }
  1453.     eval lappend pages -n [list "Page $page"] $args        
  1454.     set res [eval [concat dialog -w 480 -h $height \
  1455.       -t [list $title] 60 10 $width 30 \
  1456.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] \
  1457.       [list -m [concat [list [lindex $names 0]] $names] 400 10 475 30] $pages]]
  1458.     } else {
  1459.     set height [expr {$t + 40}]
  1460.     set res [eval [concat dialog -w 480 -h $height \
  1461.       -t [list $title] 60 10 $width 30 \
  1462.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] $args]]
  1463.     }
  1464. }
  1465.  
  1466. proc dialog::helpdescription {hlp} {
  1467.     set hlp [split $hlp |]
  1468.     if {[llength $hlp] <= 1} {
  1469.     return [lindex $hlp 0]
  1470.     }
  1471.     set res ""
  1472.     for {set hi 0} {$hi < [llength $hlp]} {incr hi} {
  1473.     set hitem [lindex $hlp $hi]
  1474.     if {$hitem != ""} {
  1475.         if {$hi == 0} {
  1476.         regsub "click this box\\.?" $hitem "turn this item on" hitem
  1477.         } elseif {$hi == 2} {
  1478.         regsub "click this box\\.?" $hitem "turn this item off" hitem
  1479.         }
  1480.         append res $hitem ". "
  1481.     }
  1482.     }
  1483.     return $res
  1484. }
  1485.  
  1486. # ◊◊◊◊ Dialog utilities ◊◊◊◊ #
  1487. proc dialog::handleSet {res names} {
  1488.     # to account for sub-lists in the list of names
  1489.     foreach n $names {
  1490.     if {[llength $n] > 1} {
  1491.         eval lappend newnames [lrange $n 1 end]
  1492.     } else {
  1493.         lappend newnames $n
  1494.     }
  1495.     }
  1496.     set names $newnames
  1497.     unset newnames
  1498.     global flag::type
  1499.     # a 'set…' button was pressed
  1500.     for {set i 0} {$i < [llength $names]} {incr i} {
  1501.     if {[lindex $res $i] == 1} {
  1502.         set v [lindex $names $i]
  1503.         if {[regexp "SearchPath$" $v]} {
  1504.         set res [buttonAlert "Perform what action to one of the [quote::Prettify $v]s" "Add" "Remove" "Change" "Cancel"]
  1505.         switch -- $res {
  1506.             "Add" {
  1507.             # this set… pressed
  1508.             if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1509.                 set newval [concat [dialog::getFlag $v] [list $newval]] 
  1510.                 dialog::modified $v $newval
  1511.             }
  1512.             }
  1513.             "Remove" {
  1514.             if {![catch {set remove [listpick -p "Remove which items from [quote::Prettify $v]:" -l [dialog::getFlag $v]]}]} {
  1515.                 # remove them
  1516.                 set newval [lremove -l [dialog::getFlag $v] $remove] 
  1517.                 dialog::modified $v $newval
  1518.             }
  1519.             }
  1520.             "Change" {
  1521.             if {![catch {set change [listpick -p "Change which item from [quote::Prettify $v]:" [dialog::getFlag $v]]}]} {
  1522.                 # change it
  1523.                 if {![catch {get_directory -p "Replacement [quote::Prettify $v]:"} newval]} {
  1524.                 set old [dialog::getFlag $v]
  1525.                 set i [lsearch -exact $old $change]
  1526.                 set old [lreplace $old $i $i $newval]
  1527.                 dialog::modified $v $old
  1528.                 }
  1529.             }
  1530.             }
  1531.         }
  1532.         break
  1533.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1534.         # this set… pressed
  1535.         if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1536.             dialog::modified $v $newval
  1537.         }
  1538.         break
  1539.         } elseif {[info exists flag::type($v)]} {
  1540.         dialog::specialSet_[set flag::type($v)] $v
  1541.         break
  1542.         } elseif {[regexp "Sig$" $v]} {
  1543.         global $v
  1544.         set newval [dialog::findApp $v [set $v]]
  1545.         if {$newval != ""} {
  1546.             dialog::modified $v $newval
  1547.         }
  1548.         break
  1549.         }  
  1550.     }
  1551.     }
  1552. }
  1553.  
  1554. proc dialog::setFlag {name val} {
  1555.     global dialog::_not_global_flag
  1556.     if {${dialog::_not_global_flag} != ""} {
  1557.     global ${dialog::_not_global_flag}
  1558.     set ${dialog::_not_global_flag}($name) $val
  1559.     } else {
  1560.     global $name
  1561.     set $name $val
  1562.     }    
  1563. }
  1564.  
  1565. proc dialog::getFlag {name} {
  1566.     global dialog::_modified
  1567.     if {[info exists dialog::_modified($name)]} { 
  1568.     return [set dialog::_modified($name)] 
  1569.     } else {
  1570.     return [dialog::getOldFlag $name]
  1571.     }
  1572. }
  1573. proc dialog::getOldFlag {name} {
  1574.     global dialog::_not_global_flag
  1575.     if {${dialog::_not_global_flag} != ""} {
  1576.     global ${dialog::_not_global_flag}
  1577.     return [set ${dialog::_not_global_flag}($name)]
  1578.     } else {
  1579.     global dialog::_is_global
  1580.     if {[info exists dialog::_is_global]} {
  1581.         global global::_vars
  1582.         if {[info exists global::_vars] \
  1583.           && [set i [lsearch ${global::_vars} $name]] != -1} {
  1584.         return [lindex ${global::_vars} [incr i]]
  1585.         } 
  1586.     }
  1587.     }    
  1588.     global $name
  1589.     if {[info exists $name]} { 
  1590.     return [set $name]
  1591.     } else { 
  1592.     alertnote "Global variable '$name' in the dialog isn't set.\r\
  1593.       I'll try to fix that."
  1594.     return [set $name ""]
  1595.     }
  1596. }
  1597.  
  1598. proc dialog::is_global {script} {
  1599.     global dialog::_is_global
  1600.     set dialog::_is_global 1
  1601.     catch "[list uplevel $script]"
  1602.     unset dialog::_is_global
  1603. }
  1604. proc dialog::resetModified {} {
  1605.     global dialog::_modified
  1606.     if {[info exists dialog::_modified]} {
  1607.     unset dialog::_modified
  1608.     }
  1609. }
  1610.  
  1611. proc dialog::global_adjust_flags {values_items} {
  1612.     global flag::procs modifiedVars global::_vars
  1613.     set res [lindex $values_items 0]
  1614.     set editItems [lindex $values_items 1]
  1615.     unset values_items
  1616.     foreach fset $editItems {
  1617.     if {[llength $fset] > 1} {
  1618.         set fset [lrange $fset 1 end]
  1619.     }
  1620.     foreach flag $fset {
  1621.         set val [lindex $res 0]
  1622.         set res [lrange $res 1 end]
  1623.         dialog::postManipulate
  1624.         if {[info exists global::_vars] \
  1625.           && [set i [lsearch ${global::_vars} $flag]] != -1} {
  1626.         set orig [lindex ${global::_vars} [incr i]]
  1627.         if {$orig != $val} {
  1628.             set global::_vars [lreplace ${global::_vars} $i $i $val]
  1629.             lappend warn_global $flag
  1630.         }
  1631.         } else {
  1632.         global $flag
  1633.         set orig [set $flag]
  1634.         if {$orig != $val} {
  1635.             set $flag $val
  1636.         }
  1637.         }
  1638.         if {$orig != $val} {
  1639.         if {[info exists flag::procs($flag)]} {
  1640.             set proc [set flag::procs($flag)]
  1641.             if {([info procs $proc] != "") && ([llength [info args $proc]] == 0)} {
  1642.             eval $proc
  1643.             } else {
  1644.             eval $proc [list $flag]
  1645.             }
  1646.         }
  1647.         lappend modifiedVars $flag
  1648.         }
  1649.     }
  1650.     }
  1651.     if {[info exists warn_global]} {
  1652.     if {[llength $warn_global] == 1} {
  1653.         set msg "is a global pref"
  1654.     } else {
  1655.         set msg "are global prefs"
  1656.     }
  1657.     alertnote "You modified [join $warn_global {, }] which $msg,\
  1658.       but currently over-ridden by mode-specific values.  If you meant to\
  1659.       modify the latter values, use the mode prefs dialog."
  1660.     }
  1661. }
  1662.  
  1663. proc dialog::postManipulate {} {
  1664.     global flag::list flag::type
  1665.     upvar flag f
  1666.     upvar val v
  1667.     
  1668.     if {[info exists flag::list($f)]} {
  1669.     switch -- [lindex [set l [set flag::list($f)]] 0] {
  1670.         "index" {
  1671.         set v [lsearch -exact [lindex $l 1] $v]
  1672.         }
  1673.         "varindex" {
  1674.         set itemv [lindex $l 1]
  1675.         global $itemv
  1676.         set v [lsearch -exact [set $itemv] $v]
  1677.         }
  1678.     }
  1679.     }
  1680.     if {$v == "<none>" && [regexp "Mode$" $f]} { set v "" }
  1681.     # This check also captures any 'dialog::modified' items
  1682.     # This allows flags which are somehow already set by the
  1683.     # dialog (for instance if called recursively, or if set by embedded
  1684.     # 'Set…' buttons) to be registered as modifed by our calling procedure.
  1685.     if {[regexp "(Path|Folder|Sig)$" $f]} {
  1686.     set v [dialog::getFlag $f]
  1687.     } elseif {[info exists flag::type($f)]} {
  1688.     switch -- [set flag::type($f)] {
  1689.         "binding" {
  1690.         # setup the changed binding
  1691.         set old [dialog::getOldFlag $f]
  1692.         set v [dialog::getFlag $f]
  1693.         if {$old != $v} {
  1694.             global flag::binding
  1695.             if {[info exists flag::binding($f)]} {
  1696.             set m [lindex [set flag::binding($f)] 0]
  1697.             if {[set proc [lindex [set flag::binding($f)] 1]] == 1} {
  1698.                 set proc $f
  1699.             }
  1700.             catch "unBind [keys::toBind $old] [list $proc] $m"
  1701.             catch "Bind [keys::toBind $v] [list $proc] $m"
  1702.             }
  1703.         }
  1704.         }
  1705.         "funnyChars" {
  1706.         set v [quote::Undisplay $v]
  1707.         }
  1708.         default {
  1709.         set v [dialog::getFlag $f]
  1710.         }
  1711.     }
  1712.     }
  1713. }
  1714.  
  1715. proc dialog::modified {name val} {
  1716.     global dialog::_modified
  1717.     set dialog::_modified($name) $val
  1718. }
  1719.  
  1720. # Used on modified mode flags.
  1721. set flag::procs(stringColor) "stringColorProc"
  1722. set flag::procs(commentColor) "stringColorProc"
  1723. set flag::procs(keywordColor) "stringColorProc"
  1724. set flag::procs(funcColor) "stringColorProc"
  1725. set flag::procs(sectionColor) "stringColorProc"
  1726. set flag::procs(bracesColor) "stringColorProc"
  1727.  
  1728. proc global::updateHelperFlags {} {
  1729.     uplevel #0 {
  1730.     set flagPrefs(Helpers) {}
  1731.     set varPrefs(Helpers) [info globals *Sig]
  1732.     }
  1733. }
  1734.  
  1735. proc global::updateMiscFlags {} {
  1736.     global flagPrefs varPrefs allFlags modeVars allVars
  1737.     # flags can be in either flagPrefs or varPrefs if we're grouping
  1738.     # preferences according to function
  1739.     set all {}
  1740.     set flagPrefs(Miscellaneous) {}
  1741.     set varPrefs(Miscellaneous) {}
  1742.     foreach v [array names flagPrefs] {
  1743.     eval lappend all $flagPrefs($v)
  1744.     if {[regexp {[{}]} $varPrefs($v)]} {
  1745.         # we're grouping
  1746.         foreach i $varPrefs($v) {
  1747.         if {[llength $i] > 1} {
  1748.             eval lappend all [lrange $i 1 end]
  1749.         } else {
  1750.             lappend all $i
  1751.         }
  1752.         }
  1753.     } else {
  1754.         eval lappend all $varPrefs($v)
  1755.     }
  1756.     }
  1757.     foreach f $allFlags {
  1758.     if {([lsearch $modeVars $f] < 0)} {
  1759.         if {[lsearch -exact $all $f] == -1} {
  1760.         lappend flagPrefs(Miscellaneous) $f
  1761.         }
  1762.     }
  1763.     }
  1764.     
  1765.     foreach f $allVars {
  1766.     if {([lsearch $modeVars $f] < 0)} {
  1767.         if {[lsearch -exact $all $f] == -1} {
  1768.         if {[regexp {Sig$} $f]} {
  1769.             lappend varPrefs(Helpers) $f
  1770.         } else {
  1771.             lappend varPrefs(Miscellaneous) $f
  1772.         }
  1773.         }
  1774.     }
  1775.     }
  1776. }
  1777.  
  1778. #================================================================================
  1779.  
  1780. proc maxListItemLength {l} {
  1781.     set m 0
  1782.     foreach item $l {
  1783.     if {[set mm [string length $item]] > $m} { set m $mm }
  1784.     }
  1785.     return $m
  1786. }
  1787.  
  1788. proc stringColorProc {flag} {
  1789.     global $flag mode
  1790.     
  1791.     if {[set $flag] == "none"} {
  1792.         set $flag "foreground"
  1793.     }
  1794.     if {$flag == "stringColor"} {
  1795.         regModeKeywords -a -s $stringColor $mode
  1796.     } elseif {$flag == "commentColor"} {
  1797.         regModeKeywords -a -c $commentColor $mode
  1798.     } elseif {$flag == "funcColor"} {
  1799.         regModeKeywords -a -f $funcColor $mode
  1800.     } elseif {$flag == "bracesColor"} {
  1801.         regModeKeywords -a -I $bracesColor $mode
  1802.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  1803.         alertnote "Change in keyword color will take effect after Alpha restarts."
  1804.         return
  1805.     } else {
  1806.         alertnote "Change in $flag color will take effect after Alpha restarts."
  1807.         return
  1808.     }
  1809.     refresh
  1810. }
  1811.  
  1812. # ◊◊◊◊ Dialog sub-items ◊◊◊◊ #
  1813.  
  1814. proc dialog::buttonSet {x y} {
  1815.     return [list -b Set… $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1816. }
  1817.  
  1818. proc dialog::okcancel {x yy {vertical 0}} {
  1819.     upvar $yy y
  1820.     set i [dialog::button "OK" $x y]
  1821.     if {!$vertical} {
  1822.     incr y -30
  1823.     incr x 80
  1824.     }
  1825.     eval lappend i [dialog::button "Cancel" $x y]
  1826.     return $i
  1827. }
  1828.  
  1829. proc dialog::menu {x yy item {def "def"} {requestedWidth 0}} { 
  1830.     upvar $yy y
  1831.     set m [concat [list $def] $item]
  1832.     if {$requestedWidth == 0} {
  1833.     set popUpWidth 340
  1834.     } else {
  1835.     set popUpWidth $requestedWidth 
  1836.     }
  1837.     
  1838.     set res [list -m $m  $x $y [expr {$x + $popUpWidth}] [expr {$y +20}]]
  1839.     incr y 20
  1840.     return $res
  1841. }
  1842. ## 
  1843.  # -------------------------------------------------------------------------
  1844.  # 
  1845.  # "dialog::button" --
  1846.  # 
  1847.  #  Create a dialog string encoding one or more buttons.  'name' is the
  1848.  #  name of the button ("Ok" etc), x is the x position, or if x is null,
  1849.  #  then we use the variable called 'x' in the calling procedure.  yy is
  1850.  #  the name of a variable containing the y position of the button, which
  1851.  #  will be incremented by this procedure.  if args is non-null, it
  1852.  #  contains further name-x-yy values to be lines up next to this button.
  1853.  #  For sequences of default buttons, a spacing of '80' is usual, but
  1854.  #  it's probably best if you just set the 'x' param to "" and let this
  1855.  #  procedure calculate them for you.  See dialog::yesno for a good
  1856.  #  example of calling this procedure.
  1857.  # -------------------------------------------------------------------------
  1858.  ##
  1859. proc dialog::button {name x yy args} { 
  1860.     upvar $yy y
  1861.     if {$x == ""} {
  1862.     unset x
  1863.     upvar x x
  1864.     }
  1865.     set add 65
  1866.     if {[set i [expr {[string length $name] - 7}]] > 0} { 
  1867.     incr add [expr {$i * 7}]
  1868.     }
  1869.     set res [list -b $name $x $y [expr {$x +$add}] [expr {$y +20}]]
  1870.     incr x $add
  1871.     incr x 15
  1872.     if {[llength $args]} {
  1873.     eval lappend res [eval dialog::button $args]
  1874.     return $res
  1875.     }
  1876.     incr y 30
  1877.     return $res
  1878. }
  1879. proc dialog::title {name w} {
  1880.     set l [expr {${w}/2 - 4 * [string length $name]}]
  1881.     if {$l < 0} {set l 0}
  1882.     return [list -t $name $l 10 [expr {$w - $l}] 25]
  1883. }
  1884. ## 
  1885.  # -------------------------------------------------------------------------
  1886.  # 
  1887.  # "dialog::text" --
  1888.  # 
  1889.  #  Creates a text box wrapping etc the text to fit appropriately.
  1890.  #  In the input text 'name', "\r" is used as a paragraph delimiter,
  1891.  #  and "\n" is used to force a linebreak.  Paragraphs have a wider
  1892.  #  spread.
  1893.  # -------------------------------------------------------------------------
  1894.  ##
  1895. proc dialog::text {name x yy {split 0}} {
  1896.     upvar $yy y
  1897.     if {!$split || $name == ""} {
  1898.     set res [list -t $name $x $y [expr {$x + 7 * [string length $name]}] \
  1899.       [expr {$y +15}]]
  1900.     incr y 18
  1901.     } else {
  1902.     global fillColumn
  1903.     if {[info exists fillColumn]} {
  1904.         set f $fillColumn
  1905.     }
  1906.     set fillColumn $split
  1907.     set name [string trim $name]
  1908.     set paragraphList [split $name "\r"]
  1909.     foreach para $paragraphList {
  1910.         set lines ""
  1911.         foreach line [split $para "\n"] {
  1912.         lappend lines [breakIntoLines $line]
  1913.         }
  1914.         set lines [join $lines "\r"]
  1915.         foreach line [split $lines "\r"] {
  1916.         eval lappend res [list -t $line $x $y [expr {$x + 4+ 8 * [string length $line]}] \
  1917.           [expr {$y +15}]]
  1918.         incr y 18
  1919.         }
  1920.         incr y 10
  1921.     }
  1922.     if {[info exists f]} {
  1923.         set fillColumn $f
  1924.     } else {
  1925.         unset fillColumn
  1926.     }
  1927.     }
  1928.     return $res
  1929. }
  1930. proc dialog::edit {name x yy chars {cols 1}} {
  1931.     upvar $yy y
  1932.     set res [list -e $name $x $y [expr {$x + 10 * $chars}] [expr {$y + 15 * $cols}]]
  1933.     incr y [expr {5 + 15*$cols}]
  1934.     return $res
  1935. }
  1936. proc dialog::textedit {name default x yy chars {height 1}} {
  1937.     upvar $yy y
  1938.     set res [list -t $name $x $y [expr {$x + 8 * [string length $name]}]\
  1939.       [expr {$y +16}] \
  1940.       -e $default $x [expr {$y + 20}] [expr {$x + 10 * $chars}] \
  1941.       [expr {$y +20 + 16*$height}]]
  1942.     incr y [expr {24 + 16*$height}]
  1943.     return $res
  1944. }
  1945. proc dialog::checkbox {name default x yy} {
  1946.     upvar $yy y
  1947.     set res [list -c $name $default $x $y]
  1948.     set c [regsub -all -nocase {[wm]} $name "" ""]
  1949.     set d [regsub -all  {[ il',;:.]} $name "" ""]
  1950.     set len [expr {11 * [string length $name] + 6 * $c - 5 * $d}]
  1951.     lappend res [expr {$x + $len}] [expr {$y +15}]
  1952.     incr y 18
  1953.     return $res
  1954. }
  1955.  
  1956. # ◊◊◊◊ Multiple bindings dialogs ◊◊◊◊ #
  1957.  
  1958. proc dialog::arrayBindings {name array {for_menu 0}} {
  1959.     upvar $array a
  1960.     foreach n [array names a] {
  1961.     lappend l [list $a($n) $n]
  1962.     }
  1963.     if {[info exists l]} {
  1964.     eval dialog::adjustBindings [list $name modified "" $for_menu] $l
  1965.     }
  1966.     array set a [array get modified]
  1967. }
  1968.  
  1969. ## 
  1970.  # -------------------------------------------------------------------------
  1971.  # 
  1972.  # "dialog::adjustBindings" --
  1973.  # 
  1974.  #  'args' is a list of pairs.  The first element of each pair is the 
  1975.  #  menu binding, and the second element is a descriptive name for the
  1976.  #  element. 'array' is the name of an array in the calling proc's
  1977.  #  scope which is used to return modified bindings.
  1978.  # 
  1979.  # Results:
  1980.  #  
  1981.  # --Version--Author------------------Changes-------------------------------
  1982.  #    1.0     Johan Linde               original for html mode
  1983.  #    1.1     <darley@fas.harvard.edu> general purpose version
  1984.  #    1.2     Johan Linde              split into two pages when many items
  1985.  # -------------------------------------------------------------------------
  1986.  ##
  1987. proc dialog::adjustBindings {name array {mod {}} {for_menu 1} args} {
  1988.     global screenHeight
  1989.     regsub -all {\"\(-\"} $args "" items
  1990.     upvar $array key_changes
  1991.     
  1992.     foreach it $items {
  1993.     if {[info exists key_changes([lindex $it 1])]} {
  1994.         set tmpKeys([lindex $it 1]) $key_changes([lindex $it 1])
  1995.     } else {
  1996.         set tmpKeys([lindex $it 1]) [lindex $it 0]
  1997.     }
  1998.     }
  1999.     # do we return modified stuff?
  2000.     if {$mod != ""} { upvar $mod modified }
  2001.     set modified ""
  2002.     set page "Page 1 of $name"
  2003.     while {1} {
  2004.     # Build dialog.
  2005.     set twoWindows 0
  2006.     set box ""
  2007.     set h 30
  2008.     foreach it $items {
  2009.         if {$it == "(-"} {continue}
  2010.         set w 210
  2011.         set w2 370
  2012.         set key $tmpKeys([lindex $it 1])
  2013.         set key1 [dialog::specialView_binding $key]
  2014.         set it2 [split [lindex $it 1] /]
  2015.         if {[llength $it2] == 1} {
  2016.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2017.         eval lappend box [dialog::buttonSet 10 $h]
  2018.         incr h 17
  2019.         } else {
  2020.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2021.         eval lappend box [dialog::buttonSet 10 [expr {$h +8}]]
  2022.         incr h 17
  2023.         if {$key1 != "<no binding>"} {regsub {((ctrl-)?(shift-)?)(.*)} $key1 {\1opt-\4} key1}
  2024.         lappend box -t [lindex $it2 1] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2025.         incr h 17
  2026.         }
  2027.         if {$it != [lindex $items [expr {[llength $items] -1}]] && !$twoWindows && [set twoWindows [expr {$h + 100 > $screenHeight}]]} {
  2028.         set box " -n [list [concat Page 1 of $name]] $box -n [list [concat Page 2 of $name]] "
  2029.         set hmax $h; set h 30
  2030.         }
  2031.     }
  2032.     if {[info exists hmax]} {set h $hmax}
  2033.     if {$twoWindows} {
  2034.         set top "-m [list [list $page [concat Page 1 of $name] [concat Page 2 of $name]]] 10 10 370 25"
  2035.     } else {
  2036.         set top "-t [list $name] 50 10 250 25"
  2037.     }
  2038.     set buttons "-b OK 20 [expr {$h + 10}] 85 [expr {$h + 30}]  -b Cancel 105 [expr {$h + 10}] 170 [expr {$h + 30}]"
  2039.     set values [eval [concat dialog -w 380 -h [expr {$h + 40}]  $buttons $top $box]]
  2040.     if {$twoWindows} {set page [lindex $values 2]}
  2041.     if {[lindex $values 1]} {
  2042.         # Cancel
  2043.         return "Cancel"
  2044.     } elseif {[lindex $values 0]} {
  2045.         # Save new key bindings
  2046.         foreach it $modified {
  2047.         set key_changes($it) $tmpKeys($it)
  2048.         }
  2049.         return
  2050.     } else {
  2051.         # Get a new key.
  2052.         set it [lindex [lindex $items [expr {[lsearch $values 1] - 2 - $twoWindows}]] 1]
  2053.         if {![catch {dialog::getAKey $it $tmpKeys($it) $for_menu} newKey]  && $newKey != $tmpKeys($it)} {
  2054.         set tmpKeys($it) $newKey
  2055.         lappend modified $it
  2056.         }
  2057.     }
  2058.     }
  2059. }
  2060.  
  2061. # ◊◊◊◊ Manipulation of special pref types ◊◊◊◊ #
  2062.  
  2063. proc dialog::specialView_binding {key} {
  2064.     append key1 [keys::modifiersTo $key "verbose"]
  2065.     append key1 [keys::verboseKey $key]
  2066.     if {$key1 == ""} { return "<no binding>" }
  2067.     return $key1
  2068. }
  2069.  
  2070. proc dialog::specialSet_binding {v {menu 0}} {
  2071.     # Set… pressed
  2072.     set oldB [dialog::getFlag $v]
  2073.     if {![catch {dialog::getAKey [quote::Prettify $v] $oldB $menu} newKey] && $newKey != $oldB} {
  2074.     dialog::modified $v $newKey
  2075.     }
  2076. }
  2077.  
  2078. proc dialog::specialView_menubinding {key} {
  2079.     dialog::specialView_binding $key
  2080. }
  2081.  
  2082. proc dialog::specialSet_menubinding {v} {
  2083.     dialog::specialSet_binding $v 1
  2084. }
  2085. proc dialog::specialView_Sig {vv} {
  2086.     if {$vv != ""} {
  2087.     if {[catch {nameFromAppl $vv} path]} {
  2088.         return "Unknown application with sig '$vv'"
  2089.     } else {
  2090.         return [dialog::specialView_file $path]
  2091.     }
  2092.     }
  2093.     return ""
  2094. }
  2095.  
  2096. proc dialog::specialView_io-file {vv} {
  2097.     dialog::specialView_file $vv
  2098. }
  2099.  
  2100. proc dialog::specialView_file {vv} {
  2101.     if {[set sl [string length $vv]] > 40} {
  2102.     set vv "[string range $vv 0 14]...[string range $vv [expr {$sl -22}] end]"
  2103.     }
  2104.     return $vv
  2105. }
  2106. proc dialog::specialSet_file {v} {
  2107.     # Set… pressed
  2108.     set old [dialog::getFlag $v]
  2109.     if {![catch {getfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2110.       && $ff != $old} {
  2111.     dialog::modified $v $ff
  2112.     }
  2113. }
  2114. proc dialog::specialSet_io-file {v} {
  2115.     # Set… pressed
  2116.     set old [dialog::getFlag $v]
  2117.     if {![catch {putfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2118.       && $ff != $old} {
  2119.     dialog::modified $v $ff
  2120.     }
  2121. }
  2122.  
  2123.  
  2124.  
  2125.  
  2126.  
  2127.